home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / misc_pto / anaglph / anahid.bas next >
BASIC Source File  |  1991-10-24  |  4KB  |  99 lines
  1.  
  2. REM  ANAGLYPH (HIDDEN LINES REMOVED)--------1024x768
  3. '$INCLUDE: 'gxlib.bas'
  4. '$INCLUDE: 'grlib.bas'
  5. retcode% = gxSetDisplay%(gxTS.38)
  6. retcode% = gxSetMode%(gxTEXT)
  7. PI = 3.1416: OOB = 0
  8. INPUT "E,D,A,B,XI,XF,DX,YI,YF,DY "; E, D, A, B, XI, XF, DX, YI, YF, DY
  9. INPUT "Amp,Dec,Freq "; TI, U, V
  10. A = PI * A / 180: B = PI * B / 180
  11. cosa = COS(A): cosb = COS(B): sina = SIN(A): sinb = SIN(B)
  12. retcode% = gxSetMode%(gxGRAPHICS)
  13. retcode% = grSetViewPort%(0, 0, 1023, 767)
  14. retcode% = grSetViewWorld%(-511, -383, 511, 383)
  15. retcode% = grSetWorld%(gxTRUE)
  16. retcode% = grClearViewPort%
  17.  
  18. FOR image = 1 TO 2 ' two different perspectives
  19. FOR mesh = 1 TO 2
  20. FOR x = XI TO XF STEP DX: XSQ = x * x
  21. FOR y = YI TO YF STEP DY: YSQ = y * y
  22.  
  23. IF image = 1 THEN COLOUR = 4 ELSE COLOUR = 1
  24.  
  25. '************ surface equation *********
  26. Z1 = TI * (EXP(-(U * ((XSQ) + (YSQ)))))
  27. Z2 = COS(V * (SQR((XSQ) + (YSQ))))
  28. Z = Z1 * Z2
  29. '***************************************
  30.  
  31. '**************************** Alpha/Beta rotation equations ********
  32. XAB = x * cosa * cosb - y * sina * cosb + Z * sinb
  33. YAB = x * sina + y * cosa
  34. ZAB = -x * cosa * sinb + y * sina * sinb + Z * cosb
  35. '*******************************************************************
  36.  
  37. '*********************** screen projections ************************
  38. TL = D / (D - XAB)
  39. YP = CINT(E + ((YAB - E) * TL))
  40. ZP = CINT(ZAB * TL)
  41. '*******************************************************************
  42.  
  43. '***************************** Don't waste time replotting *********
  44. PCOLOR% = grGetPixel%(YP, ZP)
  45. IF image = 1 AND PCOLOR% = 4 THEN GOTO 7
  46. IF image = 2 AND PCOLOR% = 1 THEN GOTO 7
  47. IF image = 2 AND PCOLOR% = 4 THEN COLOUR = 5
  48. IF image = 2 AND PCOLOR% = 5 THEN GOTO 7
  49. '*******************************************************************
  50.  
  51. dist = SQR(((XAB - D) * (XAB - D)) + ((YAB - E) * (YAB - E)) + (ZAB * ZAB))
  52. STP = -(30 / dist): RES = 1 'initally coarse step
  53. TAL = 0
  54. 222 FOR t = 1 TO 0 STEP STP 'scan in surface-to-eye direction
  55. TAL = TAL + 1
  56.  
  57. '******************************* 3D line equations *****************
  58. xl = D + ((XAB - D) * t)
  59. yl = E + ((YAB - E) * t)
  60. zl = ZAB * t
  61. '*******************************************************************
  62.  
  63. '************************** unrotate: Beta/Alpha sequence **********
  64. sina = -sina: sinb = -sinb
  65. XBA = xl * cosa * cosb - yl * sina + zl * cosa * sinb
  66. YBA = xl * sina * cosb + yl * cosa + zl * sina * sinb
  67. ZBA = -xl * sinb + zl * cosb
  68. sina = -sina: sinb = -sinb
  69. '*******************************************************************
  70.  
  71. '*********************** unrotate surface point ********************
  72. zuna = TI * (EXP(-(U * ((XBA * XBA) + (YBA * YBA)))))
  73. zunb = COS(V * (SQR((XBA * XBA) + (YBA * YBA))))
  74. zun = zuna * zunb
  75. '*******************************************************************
  76.  
  77. diff = SGN(CINT(ZBA) - CINT(zun)) 'reference line point to surface
  78. IF TAL < 3 THEN GOTO 22 'escape surface tension
  79. IF TAL = 3 THEN ref = diff
  80. IF diff - ref <> 0 THEN GOTO 7 'point is hidden
  81.  
  82. '***** set hi-res line scan and check for out of bounds (OOB) ******
  83. IF ((XBA >= XF) OR (XBA <= XI) OR (YBA >= YF) OR (YBA <= YI)) THEN OOB = 1
  84. IF (OOB = 1) AND (RES = 1) THEN STP = STP / 64: TAL = 0: RES = 0: GOTO 222
  85. IF (OOB = 1) AND (RES = 0) THEN retcode% = grPutPixel%(YP, ZP, COLOUR): OOB = 0: EXIT FOR
  86. '*******************************************************************
  87. 22 NEXT t
  88.  
  89. 7 NEXT y, x
  90. SWAP DX, DY
  91. NEXT mesh
  92. E = -E 'switch eyes
  93. NEXT image
  94. BEEP
  95. DO: LOOP WHILE INKEY$ = ""
  96. retcode% = gxSetMode%(gxTEXT)
  97. END
  98.  
  99.